Ana Paula Pacheco, COVID-19 HPP 2020
Análise: Henrique Laureano
Last modification on 2021-06-21 17:08:40
if (!requireNamespace('pacman', quietly=TRUE)) install.packages('pacman')
pacman::p_load(
## data manipulation
readxl, dplyr, lubridate, tidyr, haven, stringr, DT, skimr,
forcats, rsample, zoo, visdat,
ggplot2, ##::cut_width()/interval()/number()
## data analysis
rsample, recipes, parsnip, glmnet, workflows, dials, tictoc,
doParallel, tune, yardstick, broom, purrr,
## data visualization
ggplot2, ggthemes, patchwork, vip, scales
)dat_casos <- readxl::read_xls('1_Casos incluidos_codigos_15_06b.xls',
sheet='Casos',
col_types=c(rep('guess', 7), 'date',
rep('guess', 3), 'date',
rep('guess', 13),
rep('date', 2),
rep('guess', 4),
rep('date', 2),
rep('guess', 2),
rep('date', 2),
rep('guess', 19), 'date',
rep(c('guess', 'date'), 23),
rep('guess', 3),
rep('numeric', 2), 'guess',
rep(c('guess', 'date'), 23),
rep('guess', 3), 'date',
rep('guess', 162-159)))
dat_casos <- dat_casos|>
dplyr::mutate(
idade=(dat_casos$'DATA COLETA' - DN)/lubridate::dyears()
)
dat_casos$idade[96] <- 15
## 140
## dat_casos|>
## dplyr::filter(UTI==0 & VM==1)|>
## dplyr::select(codigo)
dat_casos$UTI[140] <- 1
dat_ct <- readxl::read_xls('1_Casos incluidos_codigos_15_06b.xls',
sheet='CT')
## DT::datatable(dat_casos,
## options=list(pageLength=6),
## class='cell-border stripe',
## rownames=FALSE)
##
## DT::datatable(dat_ct,
## options=list(pageLength=6),
## class='cell-border stripe',
## rownames=FALSE)Análise descritiva
Idade e medidas binárias
box_idade <-
ggplot(dat_casos, aes(x=idade, y=NA))+
geom_boxplot()+
geom_jitter(size=4/3, alpha=0.4)+
stat_summary(fun=mean, geom='point', size=4, color='red')+
labs(title=paste('Boxplot das', nrow(dat_casos), 'idades'))+
theme_fivethirtyeight(base_size=14)+
theme(axis.text.y=element_blank())
box_sexo <- dat_casos|>
dplyr::mutate(
Sexo=dplyr::recode(Sexo,
F=paste(table(Sexo)[1], 'femininos'),
M=paste(table(Sexo)[2], 'masculinos'))
)|>
ggplot(aes(x=idade, y=Sexo))+
geom_boxplot()+
geom_jitter(size=4/3, alpha=0.4)+
stat_summary(fun=mean, geom='point', size=4, color='red')+
labs(title='por sexo')+
theme_fivethirtyeight(base_size=14)
box_pcomo <- dat_casos|>
dplyr::mutate(
pcomorbidade=dplyr::recode(
pcomorbidade,
'0'=paste(table(pcomorbidade)[1],
'sem comorbidade'),
'1'=paste(table(pcomorbidade)[2],
'com comorbidade'))
)|>
ggplot(aes(x=idade, y=pcomorbidade))+
geom_boxplot()+
geom_jitter(size=4/3, alpha=0.4)+
stat_summary(fun=mean, geom='point', size=4, color='red')+
labs(title='por comorbidade')+
theme_fivethirtyeight(base_size=14)
box_inter <- dat_casos|>
dplyr::mutate(
Internou=dplyr::recode(Internou,
'0'=paste(table(Internou)[1],
'não internaram'),
'1'=paste(table(Internou)[2],
'internaram'))
)|>
ggplot(aes(x=idade, y=Internou))+
geom_boxplot()+
geom_jitter(size=4/3, alpha=0.4)+
stat_summary(fun=mean, geom='point', size=4, color='red')+
labs(title='por necessidade de internação')+
theme_fivethirtyeight(base_size=14)
box_uti <- dat_casos|>
dplyr::mutate(
UTI=dplyr::recode(
UTI,
'0'=paste(table(UTI)[1], 'fora de UTI'),
'1'=paste(table(UTI)[2], 'em UTI'))
)|>
ggplot(aes(x=idade, y=UTI))+
geom_boxplot()+
geom_jitter(size=4/3, alpha=0.4)+
stat_summary(fun=mean, geom='point', size=4, color='red')+
labs(title='por necessidade de UTI')+
theme_fivethirtyeight(base_size=14)
box_vm <- dat_casos|>
dplyr::mutate(
VM=dplyr::recode(VM,
'0'=paste(table(VM)[1], 'fora de VM'),
'1'=paste(table(VM)[2], 'em VM'))
)|>
ggplot(aes(x=idade, y=VM))+
geom_boxplot()+
geom_jitter(size=4/3, alpha=0.4)+
stat_summary(fun=mean, geom='point', size=4, color='red')+
labs(title='por necessidade de VM')+
theme_fivethirtyeight(base_size=14)
box_contato <- dat_casos|>
dplyr::mutate(
contato=CONTATO_CONFIRMADO_OU_SUSPEITO,
contato=dplyr::recode(contato,
'0'=paste(table(contato)[1],
'sem contato'),
'1'=paste(table(contato)[2],
'com contato'),
'9'=paste(table(contato)[3],
'não disponível'))
)|>
ggplot(aes(x=idade, y=contato))+
geom_boxplot()+
geom_jitter(size=4/3, alpha=0.4)+
stat_summary(fun=mean, geom='point', size=4, color='red')+
labs(title='por contato confirmado')+
theme_fivethirtyeight(base_size=13)
(box_idade+box_sexo)/
(box_pcomo+box_contato)/
box_inter/
box_uti/
box_vm
Idades segredadas pelas medidas
box_wrap1 <- dat_casos|>
dplyr::mutate(UTI=dplyr::recode(UTI,
'0'='Fora de UTI', '1'='Em UTI'),
pcomorbidade=dplyr::recode(pcomorbidade,
'0'='Sem comorbidade',
'1'='Com comorbidade'),
Internou=dplyr::recode(Internou,
'0'='& sem internação',
'1'='& com internação'),
VM=dplyr::recode(VM, '0'='Fora de VM', '1'='Em VM')
)|>
ggplot(aes(x=idade, y=UTI))+
geom_boxplot(outlier.shape=NA)+
facet_wrap(~pcomorbidade+Internou, scales='free')+
geom_jitter(aes(color=VM), size=4/2, alpha=0.75)+
stat_summary(fun=mean, geom='point', size=4, color='red')+
labs(title=paste('Boxplot das', nrow(dat_casos), 'idades por',
'presença de comorbidade,',
'\nnecessidade de internação, UTI e VM'))+
theme_fivethirtyeight(base_size=14)+
scale_color_viridis_d(end=0.5)+
theme(legend.title=element_blank())
box_wrap2 <- dat_casos|>
dplyr::mutate(contato=CONTATO_CONFIRMADO_OU_SUSPEITO,
contato=dplyr::recode(contato,
'0'='Sem contato',
'1'='Com contato',
'9'='Não disponível'),
pcomorbidade=dplyr::recode(pcomorbidade,
'0'='Sem comorbidade',
'1'='Com comorbidade'),
Internou=dplyr::recode(Internou,
'0'='& sem internação',
'1'='& com internação'),
UTI=dplyr::recode(UTI, '0'='Fora de UTI', '1'='Em UTI')
)|>
ggplot(aes(x=idade, y=contato))+
geom_boxplot(outlier.shape=NA)+
facet_wrap(~pcomorbidade+Internou)+
geom_jitter(aes(color=UTI), size=4/2, alpha=0.75)+
stat_summary(fun=mean, geom='point', size=4, color='red')+
labs(title=paste(
'presença de comorbidade, necessidade de internação,',
'\nUTI, e contato confirmado ou suspeito'))+
theme_fivethirtyeight(base_size=14)+
scale_color_viridis_d(end=0.5)+
theme(legend.title=element_blank())
box_wrap1/box_wrap2
Comorbidades
dat_comor <-
dat_casos|>
dplyr::filter(pcomorbidade==1)|>
dplyr::select(scomorbidade1:scomorbidade3)|>
dplyr::mutate(id=haven::as_factor(1:n()),
scomorbidade2=dplyr::na_if(scomorbidade2, 0),
scomorbidade3=dplyr::na_if(scomorbidade3, 0))|>
tidyr::pivot_longer(!id,
names_to='sistema', values_to='comorbidade',
values_drop_na=TRUE)|>
dplyr::mutate(comorbidade=stringr::str_to_sentence(comorbidade))
comorSum <-
dplyr::summarize(dplyr::group_by(dat_comor, comorbidade),
av_data=length(id), id='Total')
idSum <-
dplyr::summarize(dplyr::group_by(dat_comor, id),
av_data=length(id), comorbidade='Total')
ggplot(dat_comor, aes(x=comorbidade, y=id))+
geom_bin2d(fill='#8A8D8F', alpha=0.7)+
scale_x_discrete(
limits=c(levels(as.factor(dat_comor$comorbidade)), 'Total')
)+
scale_y_discrete(limits=c('Total', rev(unique(dat_comor$id))))+
geom_point(
data=idSum, color='#FF8200', alpha=0.6, size=7, shape=15
)+
geom_point(
data=comorSum, color='#FF8200', alpha=0.6, size=7, shape=15
)+
geom_text(data=idSum, aes(label=av_data))+
geom_text(data=comorSum, aes(label=av_data))+
labs(title='Comorbidades por paciente')+
theme_fivethirtyeight(base_size=14)+
theme(legend.position='none',
axis.text.x=element_text(angle=25, vjust=0.6))
Comorbidades segregadas
col_comor <- comorSum|>
dplyr::arrange(av_data)|>
dplyr::mutate(comorbidade=haven::as_factor(comorbidade))|>
ggplot(aes(y=comorbidade, x=av_data))+
geom_col(color='#8A8D8F', alpha=0.25)+
geom_text(aes(label=av_data), position=position_stack(0.5))+
labs(title=paste0(nrow(idSum), ' pacientes, \n',
sum(comorSum$av_data), ' comorbidades')
)+
theme_fivethirtyeight(base_size=14)
ids1 <- idSum|>
dplyr::filter(av_data==1)|>
dplyr::pull(id)
col_comor1 <- dat_comor|>
dplyr::filter(id%in%ids1)|>
dplyr::count(comorbidade)|>
dplyr::arrange(n)|>
dplyr::mutate(comorbidade=haven::as_factor(comorbidade))|>
ggplot(aes(y=comorbidade, x=n))+
geom_col(color='#8A8D8F', alpha=0.25)+
geom_text(aes(label=n), position=position_stack(0.5))+
labs(title=paste0(length(ids1), ' com\n', '1 comorbidade'))+
theme_fivethirtyeight(base_size=14)
ids23 <- idSum|>
dplyr::filter(av_data>1)|>
dplyr::pull(id)
dat_comor23 <- dat_comor|>
dplyr::filter(id%in%ids23)|>
dplyr::mutate(id=factor(id))
col_comor23 <- dat_comor23|>
dplyr::count(comorbidade)|>
dplyr::arrange(n)|>
dplyr::mutate(comorbidade=haven::as_factor(comorbidade))|>
ggplot(aes(y=comorbidade, x=n))+
geom_col(color='#8A8D8F', alpha=0.25)+
geom_text(aes(label=n), position=position_stack(0.5))+
theme_fivethirtyeight(base_size=14)
ids23order <- dat_comor23|>
dplyr::count(id, sort=TRUE)|>
dplyr::mutate(id=haven::as_factor(id))|>
dplyr::pull(id)
bar_comor23 <- dat_comor23|>
dplyr::mutate(
id=factor(id, levels=ids23order), Comorbidade=comorbidade
)|>
ggplot(aes(x=id, fill=Comorbidade))+
geom_bar(alpha=0.75)+
labs(title=paste(length(ids23), 'com +1 comorbidades'))+
theme_fivethirtyeight(base_size=14)+
theme(legend.title=element_blank(),
axis.text.x=element_blank())+
guides(fill=guide_legend(nrow=3))
layout <- "
AABB
CDDD
"
col_comor+col_comor1+col_comor23+bar_comor23+
patchwork::plot_layout(design=layout)
Tempo do início dos sintomas
bar_temponum <- dat_casos|>
dplyr::mutate(tempo=tempo_inicio_sintomas)|>
dplyr::filter(stringr::str_detect(tempo, '[0-9]'))|>
dplyr::mutate(tempo=factor(as.numeric(tempo)))|>
ggplot(aes(y=tempo))+
geom_bar(color='#8A8D8F', alpha=0.25)+
geom_text(stat='count',
aes(label=sprintf('%s (%.1f%%)',
after_stat(count),
after_stat(100*count/sum(count)))),
hjust=-0.1)+
xlim(c(0, 57.5))
bar_tempocha <- dat_casos|>
dplyr::mutate(tempo=tempo_inicio_sintomas)|>
dplyr::filter(!stringr::str_detect(tempo, '[0-9]'))|>
dplyr::mutate(tempo=stringr::str_to_sentence(tempo))|>
ggplot(aes(y=tempo))+
geom_bar(color='#8A8D8F', alpha=0.25)+
geom_text(stat='count',
aes(label=sprintf('%s (%.1f%%)',
after_stat(count),
after_stat(100*count/sum(count)))),
hjust=-0.1)+
xlim(c(0, 47.5))
(bar_temponum/bar_tempocha)+
plot_layout(heights=c(3.5, 1))+
plot_annotation(
title=paste('Dias a partir do início dos sintomas,',
'\npara os', nrow(dat_casos), 'pacientes')
)&theme_fivethirtyeight(base_size=13)
Tempos segregados
bar_temponumComor <- dat_casos|>
dplyr::mutate(tempo=tempo_inicio_sintomas)|>
dplyr::filter(stringr::str_detect(tempo, '[0-9]'))|>
dplyr::mutate(tempo=factor(as.numeric(tempo)),
Comorbidade=dplyr::recode(pcomorbidade,
'0'='Sem', '1'='Com')
)|>
ggplot(aes(y=tempo, fill=Comorbidade))+
geom_bar(alpha=0.75)+
geom_text(
stat='count', aes(label=..count..), position=position_stack(0.5)
)
bar_tempochaComor <- dat_casos|>
dplyr::mutate(tempo=tempo_inicio_sintomas)|>
dplyr::filter(!stringr::str_detect(tempo, '[0-9]'))|>
dplyr::mutate(tempo=stringr::str_to_sentence(tempo),
Comorbidade=dplyr::recode(pcomorbidade,
'0'='Sem', '1'='Com')
)|>
ggplot(aes(y=tempo, fill=Comorbidade))+
geom_bar(alpha=0.75)+
geom_text(
stat='count', aes(label=..count..), position=position_stack(0.5)
)
(bar_temponumComor/bar_tempochaComor)+
patchwork::plot_layout(heights=c(3.5, 1), guides='collect')+
patchwork::plot_annotation(
title=paste('Dias a partir início dos sintomas,',
'por presença de comorbidade', sep='\n')
)&theme_fivethirtyeight(base_size=13)&
scale_fill_viridis_d(begin=0.5, end=0.75)
bar_temponumInter <- dat_casos|>
dplyr::mutate(tempo=tempo_inicio_sintomas)|>
dplyr::filter(stringr::str_detect(tempo, '[0-9]'))|>
dplyr::mutate(tempo=factor(as.numeric(tempo)),
Internação=dplyr::recode(Internou,
'0'='Não', '1'='Sim')
)|>
ggplot(aes(y=tempo, fill=Internação))+
geom_bar(alpha=0.75)+
geom_text(
stat='count', aes(label=..count..), position=position_stack(0.5)
)
bar_tempochaInter <- dat_casos|>
dplyr::mutate(tempo=tempo_inicio_sintomas)|>
dplyr::filter(!stringr::str_detect(tempo, '[0-9]'))|>
dplyr::mutate(tempo=stringr::str_to_sentence(tempo),
Internação=dplyr::recode(Internou,
'0'='Não', '1'='Sim')
)|>
ggplot(aes(y=tempo, fill=Internação))+
geom_bar(alpha=0.75)+
geom_text(
stat='count', aes(label=..count..), position=position_stack(0.5)
)
(bar_temponumInter/bar_tempochaInter)+
patchwork::plot_layout(heights=c(3.5, 1), guides='collect')+
patchwork::plot_annotation(
title=paste('Dias a partir do início dos sintomas,',
'por necessidade de internação', sep='\n')
)&theme_fivethirtyeight(base_size=13)&
scale_fill_viridis_d(begin=0.5, end=0.75, direction=-1)
Raio-X e tomografia
tile_xray <-
xtabs(~RAIOX1+RAIOX2, dat_casos)|>
tibble::as_tibble()|>
dplyr::mutate(n=factor(n),
Primeira=factor(RAIOX1),
Primeira=dplyr::recode(Primeira,
'1'='Normal',
'2'='Infiltrado instersticial',
'3'='Condensação opacidade',
'4'='Hiperinsuflação',
'5'='Outro',
'6'='Não realizado'),
Segunda=factor(RAIOX2),
Segunda=dplyr::recode(Segunda,
'1'='Normal',
'2'='Infiltrado instersticial',
'3'='Condensação opacidade',
'4'='Hiperinsuflação',
'5'='Outro',
'6'='Não realizado')
)|>
ggplot(aes(x=Primeira, y=Segunda, fill=n))+
geom_tile(color='black', size=0.5, alpha=0.6)+
geom_text(aes(label=n))+
labs(title=paste0('Raio-X tórax,\n', nrow(dat_casos), ' pacientes'))+
theme_fivethirtyeight(base_size=14)+
theme(legend.position='none',
axis.title.x=element_text(),
axis.title.y=element_text(),
axis.text.x=element_text(angle=30, vjust=0.5))+
scale_fill_brewer(palette='Spectral', direction=-1)+
coord_fixed()
tile_tomo <-
xtabs(~TOMO1+TOMO2, dat_casos)|>
tibble::as_tibble()|>
dplyr::mutate(n=factor(n),
Primeira=factor(TOMO1),
Primeira=dplyr::recode(Primeira,
'1'='Normal',
'2'='Infiltrado instersticial',
'3'='Condensação opacidade',
'4'='Vidro fosco',
'5'='Outro',
'6'='Não realizado'),
Segunda=factor(TOMO2),
Segunda=dplyr::recode(Segunda,
'1'='Normal',
'2'='Infiltrado instersticial',
'3'='Condensação opacidade',
'4'='Vidro fosco',
'5'='Outro',
'6'='Não realizado')
)|>
ggplot(aes(x=Primeira, y=Segunda, fill=n))+
geom_tile(color='black', size=0.5, alpha=0.6)+
geom_text(aes(label=n))+
labs(title=paste0('Tomografia,\n', nrow(dat_casos), ' pacientes'))+
theme_fivethirtyeight(base_size=14)+
theme(legend.position='none',
axis.title.x=element_text(),
axis.title.y=element_text(),
axis.text.x=element_text(angle=30, vjust=0.5))+
scale_fill_brewer(palette='Spectral', direction=-1)+
coord_fixed()
tile_xray|tile_tomo
PCR
line_pcr <- dat_casos|>
dplyr::select(dplyr::one_of(paste0('PCR', 1:8)))|>
dplyr::mutate(id=factor(1:dplyr::n()))|>
tidyr::pivot_longer(!id, names_to='PCR', values_to='valor')|>
dplyr::mutate(valor=dplyr::na_if(valor, 'NR'),
valor=dplyr::if_else(
valor%in%c('INFERIOR 5'), '0', valor
),
valor=as.numeric(valor),
PCR=factor(PCR)
)|>
tidyr::drop_na()|>
ggplot(aes(x=PCR, y=valor, group=id, color=id, fill=id))+
geom_line(size=1.25)+
geom_point(size=2)+
theme_fivethirtyeight(base_size=14)+
scale_color_viridis_d()+
theme(legend.position='none')+
labs(title='PCRs')
line_pcrComor <- dat_casos|>
dplyr::select(dplyr::one_of(paste0('PCR', 1:8)), pcomorbidade)|>
dplyr::mutate(id=factor(1:dplyr::n()))|>
tidyr::pivot_longer(dplyr::starts_with('PCR'),
names_to='PCR', values_to='valor')|>
dplyr::mutate(valor=dplyr::na_if(valor, 'NR'),
valor=dplyr::if_else(
valor%in%c('INFERIOR 5'), '0', valor
),
valor=as.numeric(valor),
PCR=factor(PCR),
Comorbidade=dplyr::recode(pcomorbidade,
'0'='Sem comorbidade',
'1'='Com comorbidade'))|>
tidyr::drop_na()|>
ggplot(aes(x=PCR, y=valor, group=id, color=id, fill=id))+
geom_line(size=1.25)+
geom_point(size=2)+
theme_fivethirtyeight(base_size=14)+
theme(legend.position='none')+
scale_color_viridis_d()+
labs(title='por presença de comorbidade')+
facet_wrap(~Comorbidade, scales='free')
line_pcr/line_pcrComor
VHS
line_vhs <- dat_casos|>
dplyr::select(dplyr::one_of(paste0('VHS', 1:4)))|>
dplyr::mutate(id=factor(1:dplyr::n()))|>
tidyr::pivot_longer(!id, names_to='VHS', values_to='valor')|>
dplyr::mutate(valor=dplyr::na_if(valor, 'NR'),
valor=as.numeric(valor),
VHS=factor(VHS)
)|>
tidyr::drop_na()|>
ggplot(aes(x=VHS, y=valor, group=id, color=id, fill=id))+
geom_line(size=1.25)+
geom_point(size=2)+
theme_fivethirtyeight(base_size=14)+
scale_color_viridis_d()+
theme(legend.position='none')+
labs(title='VHSs')
line_vhsComor <- dat_casos|>
dplyr::select(dplyr::one_of(paste0('VHS', 1:4)), pcomorbidade)|>
dplyr::mutate(id=factor(1:dplyr::n()))|>
tidyr::pivot_longer(dplyr::starts_with('VHS'),
names_to='VHS', values_to='valor')|>
dplyr::mutate(valor=dplyr::na_if(valor, 'NR'),
valor=as.numeric(valor),
VHS=factor(VHS),
Comorbidade=dplyr::recode(pcomorbidade,
'0'='Sem comorbidade',
'1'='Com comorbidade')
)|>
tidyr::drop_na()|>
ggplot(aes(x=VHS, y=valor, group=id, color=id, fill=id))+
geom_line(size=1.25)+
geom_point(size=2)+
theme_fivethirtyeight(base_size=14)+
scale_color_viridis_d()+
theme(legend.position='none')+
labs(title='por presença de comorbidade')+
facet_wrap(~Comorbidade, scales='free')
line_vhs/line_vhsComor
Dímero-D
line_dime <- dat_casos|>
dplyr::select(dplyr::one_of(paste0('Dímero-D', 1:8)))|>
dplyr::mutate(id=factor(1:dplyr::n()))|>
tidyr::pivot_longer(!id, names_to='DímeroD', values_to='valor')|>
dplyr::mutate(valor=dplyr::na_if(valor, 'NR'),
valor=as.numeric(valor),
DímeroD=factor(DímeroD)
)|>
tidyr::drop_na()|>
ggplot(aes(x=DímeroD, y=valor, group=id, color=id, fill=id))+
geom_line(size=1.25)+
geom_point(size=2)+
theme_fivethirtyeight(base_size=14)+
scale_color_viridis_d()+
theme(legend.position='none')+
labs(title='Dímero-Ds')
line_dimeComor <- dat_casos|>
dplyr::select(dplyr::one_of(paste0('Dímero-D', 1:8)), pcomorbidade)|>
dplyr::mutate(id=factor(1:dplyr::n()))|>
tidyr::pivot_longer(dplyr::starts_with('Dímero-D'),
names_to='DímeroD', values_to='valor')|>
dplyr::mutate(valor=dplyr::na_if(valor, 'NR'),
valor=as.numeric(valor),
DímeroD=factor(DímeroD),
Comorbidade=dplyr::recode(pcomorbidade,
'0'='Sem comorbidade',
'1'='Com comorbidade')
)|>
tidyr::drop_na()|>
ggplot(aes(x=DímeroD, y=valor, group=id, color=id, fill=id))+
geom_line(size=1.25)+
geom_point(size=2)+
theme_fivethirtyeight(base_size=14)+
scale_color_viridis_d()+
theme(legend.position='none')+
labs(title='Dímero-Ds por presença de comorbidade')+
facet_wrap(~Comorbidade, scales='free')
line_dime/line_dimeComor
Município
dat_casos|>
dplyr::mutate(Município=factor(stringr::str_to_title(Município)),
Município=factor(Município,
levels=rev(levels(Município))),
Internação=dplyr::recode(Internou,
'0'='Não', '1'='Sim')
)|>
ggplot(aes(y=Município, fill=Internação))+
geom_bar(alpha=0.75)+
geom_text(
stat='count', aes(label=..count..), position=position_stack(0.5)
)+
theme_fivethirtyeight(base_size=14)+
scale_fill_viridis_d(begin=0.5, end=0.75, direction=-1)+
labs(title=paste('Município dos', nrow(dat_casos), 'pacientes,',
'\npor necessidade de internação'))
Sinais clínicos
sinaisc <- dat_casos|>
dplyr::select(FEBRE:OUTRO, Internou)|>
dplyr::mutate(id=factor(1:dplyr::n()))|>
tidyr::pivot_longer(!c(id, Internou, OUTRO),
names_to='sinal', values_to='presença')|>
dplyr::mutate(sinal=stringr::str_to_title(sinal),
Internação=dplyr::recode(Internou,
'0'='Não', '1'='Sim'))
sinaiscTable <- sinaisc|>
dplyr::filter(presença==1)|>
dplyr::count(sinal)|>
dplyr::arrange(n)|>
dplyr::mutate(sinal=haven::as_factor(sinal))
sinallevels <- levels(sinaiscTable$sinal)
ggplot(sinaiscTable, aes(y=sinal, x=n))+
geom_col(color='#8A8D8F', alpha=0.25)+
geom_text(aes(label=paste(n, '(', round(100*n/294, 1), '%)')),
hjust=-0.1)+
xlim(c(0, 210))+
labs(
title=paste('Sinais clínicos dos', nrow(dat_casos), 'pacientes')
)+
theme_fivethirtyeight(base_size=13)
Sinais clínicos por internação
sinaisc|>
dplyr::filter(presença==1)|>
dplyr::mutate(sinal=factor(sinal, levels=rev(sinallevels)))|>
ggplot(aes(y=sinal, fill=Internação))+
geom_bar(alpha=0.75)+
geom_text(
stat='count', aes(label=..count..), position=position_stack(0.5)
)+
labs(title=paste('Sinais clínicos dos', nrow(dat_casos),
'pacientes,', '\npor necessidade de internação'))+
theme_fivethirtyeight(base_size=13)+
scale_fill_viridis_d(begin=0.5, end=0.75, direction=-1)
Combinações de sinais clínicos
dat_casos|>
dplyr::select(FEBRE:AGEUSIA)|>
dplyr::group_by_all()|>
dplyr::tally()|>
dplyr::filter(n>1)|>
tibble::as_tibble()|>
dplyr::mutate(profile=as.character(1:dplyr::n()))|>
tidyr::pivot_longer(
!c(profile, n), names_to='sinal', values_to='status'
)|>
dplyr::filter(status==1)|>
dplyr::arrange(desc(n))|>
dplyr::mutate(profile=haven::as_factor(profile),
profile=factor(
profile, labels=c(1:length(levels(profile)))
),
sinal=stringr::str_to_sentence(sinal),
sinal=haven::as_factor(sinal)
)|>
ggplot(aes(x=n, y=profile, fill=sinal))+
geom_col(alpha=0.75)+
geom_text(aes(label=n), position=position_stack(0.5))+
theme_fivethirtyeight()+
theme(legend.title=element_blank())+
labs(title='Combinações de sinais clínicos com frequência > 1')
dat_casos|>
dplyr::select(FEBRE:AGEUSIA, Internou)|>
dplyr::group_by_all()|>
dplyr::tally()|>
dplyr::filter(n>1)|>
tibble::as_tibble()|>
dplyr::mutate(profile=as.character(1:dplyr::n()))|>
tidyr::pivot_longer(!c(profile, n, Internou),
names_to='sinal', values_to='status')|>
dplyr::filter(status==1)|>
dplyr::arrange(desc(n))|>
dplyr::mutate(profile=haven::as_factor(profile),
profile=factor(
profile, labels=c(1:length(levels(profile)))
),
sinal=stringr::str_to_sentence(sinal),
sinal=haven::as_factor(sinal),
Internação=dplyr::recode(Internou,
'0'='Sem internação',
'1'='Com internação')
)|>
ggplot(aes(x=n, y=profile, fill=sinal))+
geom_col(alpha=0.75)+
facet_wrap(~Internação, scales='free')+
geom_text(aes(label=n), position=position_stack(0.5))+
theme_fivethirtyeight()+
theme(legend.title=element_blank())+
labs(title=paste(
'Combinações de sinais clínicos com frequência > 1,',
'\npor necessidade de internação'))
Outros sinais clínicos
sinaiscoutroTable <- sinaisc|>
dplyr::mutate(outro=dplyr::na_if(OUTRO, 0),
outro=dplyr::recode(outro, '9'='Não disponível'),
outro=stringr::str_to_sentence(outro)
)|>
tidyr::drop_na()|>
dplyr::count(outro)|>
dplyr::arrange(n)|>
dplyr::mutate(outro=haven::as_factor(outro))
sinaloutrolevels <- levels(sinaiscoutroTable$outro)
dat_casos|>
dplyr::mutate(outro=dplyr::na_if(OUTRO, 0),
outro=dplyr::recode(outro, '9'='Não disponível'),
outro=stringr::str_to_sentence(outro),
Internação=dplyr::recode(Internou,
'0'='Não', '1'='Sim')
)|>
dplyr::select(outro, Internação)|>
tidyr::drop_na()|>
dplyr::mutate(outro=factor(outro, levels=sinaloutrolevels))|>
ggplot(aes(y=outro, fill=Internação))+
geom_bar(alpha=0.75)+
labs(title=paste('Sinais clínicos dos', nrow(dat_casos),
'pacientes,', '\npor necessidade de internação'))+
geom_text(
stat='count', aes(label=..count..), position=position_stack(0.5)
)+
theme_fivethirtyeight(base_size=14)+
scale_fill_viridis_d(begin=0.5, end=0.75, direction=-1)
Linfócitos e neutrófilos
dat_casos|>
dplyr::select(linfócitos, neutrófilos)|>
tidyr::gather(key, value)|>
dplyr::mutate(value=dplyr::recode(value,
'0'='Normal',
'1'='Diminuído',
'2'='Aumentado',
'9'='Não disponível'),
key=stringr::str_to_title(key))|>
ggplot(aes(y=value, fill=key))+
geom_bar(position='dodge', alpha=0.75)+
geom_text(stat='count',
aes(label=sprintf('%s (%.1f%%)',
after_stat(count),
after_stat(100*count/294))),
hjust=-0.1, position=position_dodge(1))+
labs(title='Linfócitos e neutrófilos')+
xlim(c(0, 220))+
theme_fivethirtyeight()+
scale_fill_viridis_d(begin=0.5, end=0.75, direction=-1)+
theme(legend.title=element_blank())
bar_linfneut <- dat_casos|>
dplyr::select(linfócitos, neutrófilos)|>
tidyr::gather(key, value)|>
dplyr::mutate(value=dplyr::recode(value,
'0'='Normal',
'1'='Diminuído',
'2'='Aumentado',
'9'='Não disponível'),
key=stringr::str_to_title(key),
key=factor(key, levels=rev(unique(key)))
)|>
ggplot(aes(y=key, fill=value))+
geom_bar(alpha=0.75)+
geom_text(
stat='count', aes(label=..count..), position=position_stack(0.5),
)+
theme_fivethirtyeight(base_size=14)+
scale_fill_viridis_d(begin=0.25, end=0.75)+
theme(legend.title=element_blank())
line_linf <- dat_casos|>
dplyr::select(dplyr::one_of(paste0('linfócitos', 1:11)))|>
dplyr::mutate(id=factor(1:dplyr::n()))|>
tidyr::pivot_longer(!id, names_to='linfócitos', values_to='valor')|>
dplyr::mutate(valor=dplyr::na_if(valor, 'NR'),
valor=as.numeric(valor),
linfócitos=haven::as_factor(linfócitos)
)|>
tidyr::drop_na()|>
ggplot(aes(x=linfócitos, y=valor, group=id, color=id, fill=id))+
geom_line(size=1.25)+
geom_point(size=2)+
theme_fivethirtyeight(base_size=14)+
scale_color_viridis_d()+
theme(legend.position='none',
axis.text.x=element_text(angle=45, vjust=0.6))+
labs(title='Linfócitos')
line_neut <-
dat_casos|>
dplyr::select(dplyr::one_of(paste0('neutrófilos', 1:11)))|>
dplyr::mutate(id=factor(1:dplyr::n()))|>
tidyr::pivot_longer(!id, names_to='neutrófilos', values_to='valor')|>
dplyr::mutate(valor=dplyr::na_if(valor, 'NR'),
valor=as.numeric(valor),
neutrófilos=haven::as_factor(neutrófilos)
)|>
tidyr::drop_na()|>
ggplot(aes(x=neutrófilos, y=valor, group=id, color=id, fill=id))+
geom_line(size=1.25)+
geom_point(size=2)+
theme_fivethirtyeight(base_size=14)+
scale_color_viridis_d()+
theme(legend.position='none',
axis.text.x=element_text(angle=45, vjust=0.6))+
labs(title='Neutrófilos')
bar_linfneut/(line_linf|line_neut)+patchwork::plot_layout(heights=c(1, 2))
por comorbidade
line_linfComor <- dat_casos|>
dplyr::select(
dplyr::one_of(paste0('linfócitos', 1:11)), pcomorbidade
)|>
dplyr::mutate(id=factor(1:dplyr::n()))|>
tidyr::pivot_longer(dplyr::starts_with('linfócitos'),
names_to='linfócitos', values_to='valor')|>
dplyr::mutate(valor=dplyr::na_if(valor, 'NR'),
valor=as.numeric(valor),
linfócitos=haven::as_factor(linfócitos),
Comorbidade=dplyr::recode(pcomorbidade,
'0'='Sem comorbidade',
'1'='Com comorbidade')
)|>
tidyr::drop_na()|>
ggplot(aes(x=linfócitos, y=valor, group=id, color=id, fill=id))+
geom_line(size=1.25)+
geom_point(size=2)+
theme_fivethirtyeight(base_size=14)+
scale_color_viridis_d()+
theme(legend.position='none',
axis.text.x=element_text(angle=45, vjust=0.6))+
labs(title='Linfócitos por presença de comorbidade')+
facet_wrap(~Comorbidade, scales='free')
line_neutComor <- dat_casos|>
dplyr::select(
dplyr::one_of(paste0('neutrófilos', 1:11)), pcomorbidade
)|>
dplyr::mutate(id=factor(1:dplyr::n()))|>
tidyr::pivot_longer(dplyr::starts_with('neutrófilos'),
names_to='neutrófilos', values_to='valor')|>
dplyr::mutate(valor=dplyr::na_if(valor, 'NR'),
valor=as.numeric(valor),
neutrófilos=haven::as_factor(neutrófilos),
Comorbidade=dplyr::recode(pcomorbidade,
'0'='Sem comorbidade',
'1'='Com comorbidade')
)|>
tidyr::drop_na()|>
ggplot(aes(x=neutrófilos, y=valor, group=id, color=id, fill=id))+
geom_line(size=1.25)+
geom_point(size=2)+
theme_fivethirtyeight(base_size=14)+
scale_color_viridis_d()+
theme(legend.position='none',
axis.text.x=element_text(angle=45, vjust=0.6))+
labs(title='Neutrófilos por presença de comorbidade')+
facet_wrap(~Comorbidade, scales='free')
line_linfComor/line_neutComor
Igs
line_iga <- dat_casos|>
dplyr::select(iga1, iga2)|>
dplyr::mutate(id=factor(1:dplyr::n()))|>
tidyr::pivot_longer(!id, names_to='iga', values_to='valor')|>
dplyr::mutate(valor=dplyr::na_if(valor, 'NR'),
valor=dplyr::if_else(valor%in%c('Inferior a 10'),
'0',
valor),
valor=as.numeric(valor),
iga=factor(iga)
)|>
tidyr::drop_na()|>
ggplot(aes(x=iga, y=valor, group=id, color=id, fill=id))+
geom_line(size=1.25)+
geom_point(size=2)+
theme_fivethirtyeight(base_size=14)+
scale_color_viridis_d()+
theme(legend.position='none')+
labs(title='IgA')
line_igg <- dat_casos|>
dplyr::select(igg1, igg2)|>
dplyr::mutate(id=factor(1:dplyr::n()))|>
tidyr::pivot_longer(!id, names_to='igg', values_to='valor')|>
dplyr::mutate(valor=dplyr::na_if(valor, 'NR'),
valor=as.numeric(valor),
igg=factor(igg)
)|>
tidyr::drop_na()|>
ggplot(aes(x=igg, y=valor, group=id, color=id, fill=id))+
geom_line(size=1.25)+
geom_point(size=2)+
theme_fivethirtyeight(base_size=14)+
scale_color_viridis_d()+
theme(legend.position='none')+
labs(title='IgG')
line_igm <- dat_casos|>
dplyr::select(igm1, igm2)|>
dplyr::mutate(id=factor(1:dplyr::n()))|>
tidyr::pivot_longer(!id, names_to='igm', values_to='valor')|>
dplyr::mutate(valor=dplyr::na_if(valor, 'NR'),
valor=dplyr::if_else(valor%in%c('Inferior a 20'),
'0',
valor),
valor=as.numeric(valor),
igm=factor(igm)
)|>
tidyr::drop_na()|>
ggplot(aes(x=igm, y=valor, group=id, color=id, fill=id))+
geom_line(size=1.25)+
geom_point(size=2)+
theme_fivethirtyeight(base_size=14)+
scale_color_viridis_d()+
theme(legend.position='none')+
labs(title='IgM')
line_iga|line_igg|line_igm
Carga viral
dat_ct <- dat_ct|>
dplyr::rename('N1/N1'=Resultado...3,
'N2/ORF1ab1'=...4,
'N1/N2'=Resultado...7,
'N2/ORF1ab2'=...8,
'N1/N3'=Resultado...11,
'N2/ORF1ab3'=...12,
'N1/N4'=Resultado...15,
'N2/ORF1ab4'=...16,
'N1/N5'=Resultado...19,
'N2/ORF1ab5'=...20,
'N1/N6'=Resultado...23,
'N2/ORF1ab6'=...24,
'N1/N7'=Resultado...27,
'N2/ORF1ab7'=...28)|>
dplyr::select(dplyr::starts_with('n'))|>
dplyr::slice(-1L)|>
dplyr::mutate(dplyr::across(where(is.character),
~dplyr::na_if(., 'Lab apoio')),
dplyr::across(where(is.character),
~dplyr::na_if(., 'NI')),
dplyr::across(dplyr::everything(), as.numeric)
)line_n1n <- dat_ct|>
dplyr::select(dplyr::one_of(paste0('N1/N', 1:7)))|>
dplyr::mutate(id=factor(1:dplyr::n()))|>
tidyr::pivot_longer(!id, names_to='n1n', values_to='valor')|>
dplyr::mutate(n1n=factor(n1n))|>
tidyr::drop_na()|>
ggplot(aes(x=n1n, y=valor, group=id, color=id, fill=id))+
geom_line(size=1.25)+
geom_point(size=2)+
theme_fivethirtyeight(base_size=14)+
scale_color_viridis_d()+
theme(legend.position='none')+
labs(title='N1/Ns')
line_n1nComor <- dat_ct|>
dplyr::mutate(pcomorbidade=dat_casos$pcomorbidade)|>
dplyr::select(dplyr::one_of(paste0('N1/N', 1:7)), pcomorbidade)|>
dplyr::mutate(id=factor(1:dplyr::n()))|>
tidyr::pivot_longer(dplyr::starts_with('N1/N'),
names_to='n1n', values_to='valor')|>
dplyr::mutate(n1n=factor(n1n),
Comorbidade=dplyr::recode(pcomorbidade,
'0'='Sem comorbidade',
'1'='Com comorbidade'))|>
tidyr::drop_na()|>
ggplot(aes(x=n1n, y=valor, group=id, color=id, fill=id))+
geom_line(size=1.25)+
geom_point(size=2)+
theme_fivethirtyeight(base_size=14)+
scale_color_viridis_d()+
theme(legend.position='none')+
labs(title='por presença de comorbidade')+
facet_wrap(~Comorbidade, scales='free')
line_n1n/line_n1nComor
line_n2orf1ab <- dat_ct|>
dplyr::select(dplyr::one_of(paste0('N2/ORF1ab', 1:7)))|>
dplyr::mutate(id=factor(1:dplyr::n()))|>
tidyr::pivot_longer(!id, names_to='n2orf1ab', values_to='valor')|>
dplyr::mutate(n2orf1ab=factor(n2orf1ab))|>
tidyr::drop_na()|>
ggplot(aes(x=n2orf1ab, y=valor, group=id, color=id, fill=id))+
geom_line(size=1.25)+
geom_point(size=2)+
theme_fivethirtyeight(base_size=14)+
scale_color_viridis_d()+
theme(legend.position='none')+
labs(title='N2/ORF1abs')
line_n2orf1abComor <- dat_ct|>
dplyr::mutate(pcomorbidade=dat_casos$pcomorbidade)|>
dplyr::select(dplyr::one_of(paste0('N2/ORF1ab', 1:7)), pcomorbidade)|>
dplyr::mutate(id=factor(1:dplyr::n()))|>
tidyr::pivot_longer(dplyr::starts_with('N2/ORF1ab'),
names_to='n2orf1ab', values_to='valor')|>
dplyr::mutate(n2orf1ab=factor(n2orf1ab),
Comorbidade=dplyr::recode(pcomorbidade,
'0'='Sem comorbidade',
'1'='Com comorbidade'))|>
tidyr::drop_na()|>
ggplot(aes(x=n2orf1ab, y=valor, group=id, color=id, fill=id))+
geom_line(size=1.25)+
geom_point(size=2)+
theme_fivethirtyeight(base_size=14)+
scale_color_viridis_d()+
theme(legend.position='none')+
labs(title='por presença de comorbidade')+
facet_wrap(~Comorbidade, scales='free')
line_n2orf1ab/line_n2orf1abComor
Séries
dat_serie <- dat_casos|>
dplyr::mutate(
entrada=dat_casos$'DATA COLETA',
alta=dat_casos$'Data alta',
inter=dat_casos$'Data internamento',
entuti=dplyr::na_if(dat_casos$'ENTRADA UTI',
lubridate::ymd_hms(
'1899-12-31 00:00:00')),
saiuti=dplyr::na_if(dat_casos$'SAIDA UTI',
lubridate::ymd_hms(
'1899-12-31 00:00:00')),
entvm=dplyr::na_if(dat_casos$'INICIO VM',
lubridate::ymd_hms(
'1899-12-31 00:00:00')),
saivm=dplyr::na_if(dat_casos$'TERMINO VM',
lubridate::ymd_hms(
'1899-12-31 00:00:00')),
obito=Óbito
)|>
dplyr::select(
entrada, inter, entuti, saiuti, entvm, saivm, alta, obito
)|>
dplyr::mutate_if(is.POSIXct, as.Date)
casos <- dat_serie|>
dplyr::arrange(entrada)|>
dplyr::mutate(data=entrada)|>
dplyr::count(data)|>
dplyr::group_by(data)|>
dplyr::summarize(cases=sum(n))|>
dplyr::mutate(sumcases=cumsum(cases))
monthsD <- seq(as.Date('2020-04-15'), as.Date('2021-01-15'), by='1 month')
monthsN <- c('Abr', 'Mai', 'Jun', 'Jul', 'Ago',
'Set', 'Out', 'Nov', 'Dez', 'Jan')
newcases_daily <- casos|>
ggplot(aes(x=data, y=cases))+
geom_col(fill='#006cb8')+
scale_x_date(date_labels='%m-%Y', date_breaks='1 month')+
labs(title='Novos casos diários')+
annotate('text', x=monthsD[1:9], y=7,
label=monthsN[1:9], color='#8A8D8F', size=6)+
theme_fivethirtyeight(base_size=17)
newcases_cum <- casos|>
ggplot(aes(x=data, y=sumcases))+
geom_col(fill='#006cb8')+
scale_x_date(date_labels='%m-%Y', date_breaks='1 month')+
scale_y_continuous(breaks=c(25, 50, 100, 150, 200, 250, 294))+
labs(title='Novos casos diários acumulados')+
annotate('text', x=monthsD[1:9], y=272,
label=monthsN[1:9], color='#8A8D8F', size=6)+
theme_fivethirtyeight(base_size=17)
newcases_daily/newcases_cum
altas <- dat_serie|>
dplyr::arrange(alta)|>
dplyr::mutate(data=alta)|>
tidyr::drop_na(data)|>
dplyr::count(data)|>
dplyr::mutate(n=n*(-1))
obito <- dat_serie|>
dplyr::filter(obito==1)|>
dplyr::arrange(alta)|>
dplyr::mutate(data=alta, active=obito)|>
dplyr::select(data, active)
inter <- dplyr::bind_rows(dat_serie|>
dplyr::arrange(inter)|>
dplyr::mutate(data=inter)|>
tidyr::drop_na(data)|>
dplyr::count(data),
altas)|>
dplyr::arrange(data)|>
dplyr::group_by(data)|>
dplyr::summarize(n=sum(n))|>
dplyr::mutate(active=cumsum(n))|>
dplyr::rename(Date=data)|>
tidyr::complete(Date=seq.Date(min(Date), max(Date), by="day"))|>
tidyr::fill(active)
uti <- dplyr::bind_rows(dat_serie|>
dplyr::arrange(entuti)|>
dplyr::mutate(data=entuti)|>
tidyr::drop_na(data)|>
dplyr::count(data),
dat_serie|>
dplyr::arrange(saiuti)|>
dplyr::mutate(data=saiuti)|>
tidyr::drop_na(data)|>
dplyr::count(data)|>
dplyr::mutate(n=n*(-1)))|>
dplyr::arrange(data)|>
dplyr::group_by(data)|>
dplyr::summarize(n=sum(n))|>
dplyr::mutate(active=cumsum(n))|>
dplyr::rename(Date=data)|>
tidyr::complete(Date=seq.Date(min(Date), max(Date), by="day"))|>
tidyr::fill(active)
vm <- dplyr::bind_rows(dat_serie|>
dplyr::arrange(entvm)|>
dplyr::mutate(data=entvm)|>
tidyr::drop_na(data)|>
dplyr::count(data),
dat_serie|>
dplyr::arrange(saivm)|>
dplyr::mutate(data=saivm)|>
tidyr::drop_na(data)|>
dplyr::count(data)|>
dplyr::mutate(n=n*(-1)))|>
dplyr::arrange(data)|>
dplyr::group_by(data)|>
dplyr::summarize(n=sum(n))|>
dplyr::mutate(active=cumsum(n))|>
dplyr::rename(Date=data)|>
tidyr::complete(Date=seq.Date(min(Date), max(Date), by="day"))|>
tidyr::fill(active)
activecases <- ggplot()+
geom_area(data=inter, aes(x=Date, y=active, fill='Internação'),
alpha=0.75)+
geom_area(data=uti, aes(x=Date, y=active, fill='UTI'))+
geom_area(data=vm, aes(x=Date, y=active, fill='VM'))+
geom_bar(data=obito, stat='identity',
aes(x=data, y=active, fill='Óbito'), width=1.5)+
scale_x_date(date_labels='%m-%Y', date_breaks='1 month')+
scale_y_continuous(breaks=c(1, 3, 6, 10, 12))+
labs(title='Casos ativos diários')+
annotate('text', x=monthsD, y=11, label=monthsN, color='#8A8D8F',
size=6)+
theme_fivethirtyeight(base_size=17)+
scale_fill_manual(values=c('Internação'='#006cb8',
'UTI'='#f9db0a',
'VM'='#749c64',
'Óbito'='#ff0000'))+
## scale_fill_manual(values=c('Internação'='8A8D8F',
## 'UTI'='#FF8200',
## 'VM'='#00B2A9',
## 'Óbito'='#0080ff'))+
theme(legend.title=element_blank())
mm7da <- ggplot()+
geom_line(data=inter, aes(x=Date, y=zoo::rollmean(active, k=7, fill=0),
color='Internação'), size=1.25)+
geom_line(data=uti, aes(x=Date, y=zoo::rollmean(active, k=7, fill=0),
color='UTI'), size=1.25)+
geom_line(data=vm, aes(x=Date, y=zoo::rollmean(active, k=7, fill=0),
color='VM'), size=1.25)+
geom_line(data=obito, aes(x=data, y=zoo::rollmean(active, k=7, fill=0),
color='Óbito'), size=1.25)+
scale_x_date(date_labels='%m-%Y', date_breaks='1 month')+
scale_y_continuous(breaks=c(1, 3, 5, 7.5, 10))+
labs(title='Médias móveis de 7 dias')+
annotate('text', x=monthsD, y=17.5/2, label=monthsN, color='#8A8D8F',
size=6)+
theme_fivethirtyeight(base_size=17)+
scale_color_manual(values=c('Internação'='#006cb8',
'UTI'='#f9db0a',
'VM'='#749c64',
'Óbito'='#ff0000'))+
theme(legend.title=element_blank())
activecases/mm7da
Pirâmide etária
tIdade <- dat_casos|>
dplyr::mutate(Idade=dat_casos$'Idade anos',
Idade=cut(idade, breaks=0:18, include.lowest=TRUE),
Sexo=dplyr::recode(Sexo,
'F'='Feminino', 'M'='Masculino'))|>
dplyr::select(Idade, Sexo)
tIf <- tIdade|>
dplyr::filter(Sexo=='Feminino')|>
ggplot(aes(x=Idade))+
geom_bar(fill='#f9db0a')+
geom_text(stat='count', aes(label=..count..), hjust=1.5)+
scale_y_continuous(limits=c(20, 0), trans='reverse')+
labs(title='Pirâmide etária',
subtitle='Feminino')+
theme_fivethirtyeight(base_size=17)+
theme(axis.text.x=element_blank(),
axis.text.y=element_blank(),
plot.margin=margin(t=1, r=0, b=1, l=1, unit='lines'),
plot.subtitle=element_text(hjust=1, face='bold'))+
coord_flip()
tIm <- tIdade|>
dplyr::filter(Sexo=='Masculino')|>
ggplot(aes(x=Idade))+
geom_bar(fill='#006cb8')+
geom_text(stat='count', aes(label=..count..), hjust=-0.5)+
scale_y_continuous(limits=c(0, 34))+
labs(subtitle='Masculino')+
theme_fivethirtyeight(base_size=17)+
theme(axis.text.x=element_blank(),
axis.text.y=element_text(hjust=0.5),
plot.margin=margin(t=1, r=1, b=1, l=0, unit='lines'),
plot.subtitle=element_text(face='bold'))+
coord_flip()
tIf+tIm+patchwork::plot_layout(widths=c(0.9, 1))
Modelos
Dados
Das
162 (+CT) colunas originais, selecionamos (e criamos) as características a serem utilizadas na modelagem.
dat_models <-
dat_casos|>
dplyr::mutate(
Sexo=haven::as_factor(Sexo),
Idade=cut(
idade, breaks=c(0, 1, 2, 4, 10, 18), include.lowest=TRUE
),
Municipio=forcats::fct_collapse(
Município,
Curitiba='CURITIBA',
RM=c('ALMIRANTE TAMANDARE',
'ARAUCARIA',
'CAMPINA GRANDE DO SUL',
'CAMPO LARGO',
'COLOMBO',
'CONTENDA',
'FAZENDA RIO GRANDE',
'PINHAIS',
'PIRAQUARA',
'QUATRO BARRAS',
'QUITANDINHA',
'RIO BRANCO DO SUL',
'SAO JOSE DOS PINHAIS'),
other_level='Outro'
),
nComorbidades=dat_casos$'QUANTAS COMORBIDADES',
comoResp=as.numeric(scomorbidade1=='RESPIRATÓRIO'|
scomorbidade2=='RESPIRATÓRIO'|
scomorbidade3=='RESPIRATÓRIO'),
comoNeuro=as.numeric(scomorbidade1=='NEUROLÓGICO'|
scomorbidade2=='NEUROLÓGICO'|
scomorbidade3=='NEUROLÓGICO'),
comoOncoh=as.numeric(scomorbidade1=='ONCO-HEMATO'|
scomorbidade2=='ONCO-HEMATO'|
scomorbidade3=='ONCO-HEMATO'),
comoCardio=as.numeric(scomorbidade1=='CARDIOVASCULAR'|
scomorbidade2=='CARDIOVASCULAR'|
scomorbidade3=='CARDIOVASCULAR'),
comoImuno=as.numeric(scomorbidade1=='IMUNOLÓGICO'|
scomorbidade2=='IMUNOLÓGICO'|
scomorbidade3=='IMUNOLÓGICO'),
comoGene=as.numeric(scomorbidade1=='SD GENÉTICA'|
scomorbidade2=='SD GENÉTICA'|
scomorbidade3=='SD GENÉTICA'),
comoDiges=as.numeric(scomorbidade1=='DIGESTIVO'|
scomorbidade2=='DIGESTIVO'|
scomorbidade3=='DIGESTIVO'),
comoEndo=as.numeric(scomorbidade1=='ENDÓCRINO'|
scomorbidade2=='ENDÓCRINO'|
scomorbidade3=='ENDÓCRINO'),
comoUri=as.numeric(scomorbidade1=='URINÁRIO'|
scomorbidade2=='URINÁRIO'|
scomorbidade3=='URINÁRIO'),
tSintomas=forcats::fct_collapse(
tempo_inicio_sintomas,
Assintomático='ASSINTOMÁTICO',
'0'=c('0',
'ASSINTOMÁTICO na coleta'),
'menor7d'=c('1', '2', '3',
'4', '5', '6'),
'maior7d'=c('7', '8', '9',
'10', '12', '15')
),
tSintomas=factor(
dplyr::recode(tSintomas, 'Não disponivel'='ND')
),
Contato=dplyr::recode(
factor(CONTATO_CONFIRMADO_OU_SUSPEITO),
'0'='Não', '1'='Sim', '9'='ND'),
Febre=dplyr::recode(factor(FEBRE),
'0'='Não', '1'='Sim', '9'='ND'),
Tosse=dplyr::recode(factor(TOSSE),
'0'='Não', '1'='Sim', '9'='ND'),
Coriza=dplyr::recode(factor(CORIZA),
'0'='Não', '1'='Sim', '9'='ND'),
Cefaléia=dplyr::recode(factor(CEFALEIA),
'0'='Não', '1'='Sim', '9'='ND'),
Diarréia=dplyr::recode(factor(DIARREIA),
'0'='Não', '1'='Sim', '9'='ND'),
Odinofagia=dplyr::recode(factor(ODINOFAGIA),
'0'='Não', '1'='Sim', '9'='ND'),
Vômito=dplyr::recode(factor(VOMITO),
'0'='Não', '1'='Sim', '9'='ND'),
difResp=dplyr::recode(factor(dat_casos$'DIF RESP'),
'0'='Não', '1'='Sim', '9'='ND'),
dorAbd=dat_casos$'DOR ABD',
Náusea=NAUSEAS,
Mialgia=dplyr::recode(factor(MIALGIA),
'0'='Não', '1'='Sim', '9'='ND'),
Ageusia=dplyr::recode(factor(AGEUSIA),
'0'='Não', '1'='Sim', '9'='ND'),
Cansaço=dplyr::recode(factor(CANSAÇO),
'0'='Não', '1'='Sim', '9'='ND'),
Anosmia=dplyr::recode(factor(ANOSMIA),
'0'='Não', '1'='Sim', '9'='ND'),
Convulsão=CONVULSÃO,
OutroSN=forcats::fct_collapse(OUTRO,
Não='0',
ND='9',
other_level='Sim'),
RaioX=forcats::fct_collapse(factor(RAIOX1),
Normal='1',
NR='6',
other_level='Alterado'),
Tomografia=forcats::fct_collapse(factor(TOMO1),
Normal='1',
NR='6',
other_level='Alterado'),
PCR=dplyr::na_if(PCR1, 'NR'),
PCR=as.numeric(
dplyr::if_else(PCR%in%c('INFERIOR 5'), '0', PCR)
),
PCR=factor(tidyr::replace_na(
as.character(
cut(PCR,
breaks=c(0, 10, 50, 450),
include.lowest=TRUE)
), 'NR')),
Linfócitos=forcats::fct_collapse(factor(linfócitos),
Normal='0',
NR='9',
other_level='Alterado'),
Neutrófilos=forcats::fct_collapse(factor(neutrófilos),
Normal='0',
NR='9',
other_level='Alterado'),
N1N=dat_ct$'N1/N1',
N1N=factor(
tidyr::replace_na(as.character(
cut(N1N, breaks=c(10, 20, 30, 45),
include.lowest=TRUE)
), 'ND')),
N2ORF1ab=dat_ct$'N2/ORF1ab1',
N2ORF1ab=factor(
tidyr::replace_na(as.character(
cut(N2ORF1ab, breaks=c(10, 20, 30, 45),
include.lowest=TRUE)
), 'ND')),
Internação=factor(
dplyr::recode(Internou, '0'='Não', '1'='Sim')
),
tInternação=dat_casos$'TEMPO INTERNAÇÃO',
UTI=factor(dplyr::recode(UTI, '0'='Não', '1'='Sim')),
tUTI=dat_casos$'TEMPO UTI',
VM=factor(dplyr::recode(VM, '0'='Não', '1'='Sim')),
tVM=dat_casos$'TEMPO VM'
)|>
dplyr::select(
Sexo, Idade, Municipio, nComorbidades, comoResp,
comoNeuro, comoOncoh, comoCardio, comoImuno, comoGene,
comoDiges, comoEndo, comoUri, tSintomas, Contato, Febre,
Tosse, Coriza, Cefaléia, Diarréia, Odinofagia, Vômito,
difResp, dorAbd, Náusea, Mialgia, Ageusia, Cansaço,
Anosmia, Convulsão, OutroSN, RaioX, Tomografia, PCR,
Linfócitos, Neutrófilos, N1N, N2ORF1ab, Internação,
tInternação, UTI, tUTI, VM, tVM
)
## dat_models|>
## visdat::vis_miss()
dat_models|>
skimr::skim()| Name | dat_models |
| Number of rows | 294 |
| Number of columns | 44 |
| _______________________ | |
| Column type frequency: | |
| factor | 28 |
| numeric | 16 |
| ________________________ | |
| Group variables | None |
Variable type: factor
| skim_variable | n_missing | complete_rate | ordered | n_unique | top_counts |
|---|---|---|---|---|---|
| Sexo | 0 | 1 | FALSE | 2 | F: 148, M: 146 |
| Idade | 0 | 1 | FALSE | 5 | (4,: 88, (10: 85, [0,: 50, (1,: 37 |
| Municipio | 0 | 1 | FALSE | 3 | Cur: 200, RM: 75, Out: 19 |
| tSintomas | 0 | 1 | FALSE | 5 | men: 177, 0: 45, ND: 39, Ass: 19 |
| Contato | 0 | 1 | FALSE | 3 | Sim: 205, ND: 70, Não: 19 |
| Febre | 0 | 1 | FALSE | 3 | Sim: 182, Não: 104, ND: 8 |
| Tosse | 0 | 1 | FALSE | 3 | Não: 195, Sim: 91, ND: 8 |
| Coriza | 0 | 1 | FALSE | 3 | Não: 222, Sim: 64, ND: 8 |
| Cefaléia | 0 | 1 | FALSE | 3 | Não: 232, Sim: 54, ND: 8 |
| Diarréia | 0 | 1 | FALSE | 3 | Não: 246, Sim: 40, ND: 8 |
| Odinofagia | 0 | 1 | FALSE | 3 | Não: 252, Sim: 34, ND: 8 |
| Vômito | 0 | 1 | FALSE | 3 | Não: 256, Sim: 30, ND: 8 |
| difResp | 0 | 1 | FALSE | 3 | Não: 264, Sim: 22, ND: 8 |
| Mialgia | 0 | 1 | FALSE | 3 | Não: 268, Sim: 18, ND: 8 |
| Ageusia | 0 | 1 | FALSE | 3 | Não: 276, Sim: 10, ND: 8 |
| Cansaço | 0 | 1 | FALSE | 3 | Não: 277, Sim: 9, ND: 8 |
| Anosmia | 0 | 1 | FALSE | 3 | Não: 278, Sim: 8, ND: 8 |
| OutroSN | 0 | 1 | FALSE | 3 | Não: 164, Sim: 122, ND: 8 |
| RaioX | 0 | 1 | FALSE | 3 | NR: 214, Nor: 55, Alt: 25 |
| Tomografia | 0 | 1 | FALSE | 3 | NR: 255, Alt: 30, Nor: 9 |
| PCR | 0 | 1 | FALSE | 4 | NR: 182, [0,: 61, (10: 32, (50: 19 |
| Linfócitos | 0 | 1 | FALSE | 3 | NR: 190, Nor: 67, Alt: 37 |
| Neutrófilos | 0 | 1 | FALSE | 3 | NR: 190, Nor: 57, Alt: 47 |
| N1N | 0 | 1 | FALSE | 4 | (20: 132, [10: 60, ND: 60, (30: 42 |
| N2ORF1ab | 0 | 1 | FALSE | 4 | [10: 107, (20: 93, ND: 58, (30: 36 |
| Internação | 0 | 1 | FALSE | 2 | Não: 223, Sim: 71 |
| UTI | 0 | 1 | FALSE | 2 | Não: 271, Sim: 23 |
| VM | 0 | 1 | FALSE | 2 | Não: 282, Sim: 12 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| nComorbidades | 0 | 1 | 0.29 | 0.61 | 0 | 0 | 0 | 0 | 3 | ▇▂▁▁▁ |
| comoResp | 0 | 1 | 0.07 | 0.26 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| comoNeuro | 0 | 1 | 0.07 | 0.25 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| comoOncoh | 0 | 1 | 0.03 | 0.17 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| comoCardio | 0 | 1 | 0.03 | 0.16 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| comoImuno | 0 | 1 | 0.02 | 0.15 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| comoGene | 0 | 1 | 0.02 | 0.15 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| comoDiges | 0 | 1 | 0.02 | 0.14 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| comoEndo | 0 | 1 | 0.02 | 0.14 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| comoUri | 0 | 1 | 0.00 | 0.06 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| dorAbd | 0 | 1 | 0.06 | 0.25 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| Náusea | 0 | 1 | 0.06 | 0.24 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| Convulsão | 0 | 1 | 0.01 | 0.12 | 0 | 0 | 0 | 0 | 1 | ▇▁▁▁▁ |
| tInternação | 0 | 1 | 3.15 | 8.00 | 0 | 0 | 0 | 0 | 48 | ▇▁▁▁▁ |
| tUTI | 0 | 1 | 0.78 | 3.89 | 0 | 0 | 0 | 0 | 40 | ▇▁▁▁▁ |
| tVM | 0 | 1 | 0.39 | 2.42 | 0 | 0 | 0 | 0 | 24 | ▇▁▁▁▁ |
Dados de treino e teste
Faremos
diferentes modelos, olhando para a necessidade deinternação,UTIeVM. Com base em cada uma dessas respostas fazemos uma divisão emtreino (3/4)eteste (1/4).
dat_inter <- dat_models|>
dplyr::select(!c(tInternação, UTI, tUTI, VM, tVM))
set.seed(1512)
inter_split <- dat_inter|>
rsample::initial_split(., strata=Internação, prop=3/4)
inter_train <- inter_split|>rsample::training()
inter_test <- inter_split|>rsample::testing()
inter_recplr <- recipes::recipe(Internação~., inter_train)|>
recipes::step_dummy(
recipes::all_nominal(), -recipes::all_outcomes()
)|>
recipes::step_zv(recipes::all_predictors())|>
recipes::step_normalize(recipes::all_predictors())
## ---------------------------------------------------------------------
dat_uti <- dat_models|>
dplyr::select(!c(tUTI, Internação, tInternação, VM, tVM))
set.seed(1513)
uti_split <- dat_uti|>
rsample::initial_split(., strata=UTI, prop=3/4)
uti_train <- uti_split|>rsample::training()
uti_test <- uti_split|>rsample::testing()
uti_recplr <- recipes::recipe(UTI~., uti_train)|>
recipes::step_dummy(
recipes::all_nominal(), -recipes::all_outcomes()
)|>
recipes::step_zv(recipes::all_predictors())|>
recipes::step_normalize(recipes::all_predictors())
## ---------------------------------------------------------------------
dat_vm <- dat_models|>
dplyr::select(!c(tVM, Internação, tInternação, UTI, tUTI))
set.seed(1514)
vm_split <- dat_vm|>
rsample::initial_split(., strata=VM, prop=3/4)
vm_train <- vm_split|>rsample::training()
vm_test <- vm_split|>rsample::testing()
vm_recplr <- recipes::recipe(VM~., vm_train)|>
recipes::step_dummy(
recipes::all_nominal(), -recipes::all_outcomes()
)|>
recipes::step_zv(recipes::all_predictors())|>
recipes::step_normalize(recipes::all_predictors())inter_plr
plr <-
parsnip::logistic_reg(penalty=tune::tune(), mixture=1)|>
parsnip::set_engine('glmnet')
lambda_grid <- tibble(penalty=10^seq(-4, -1, length.out=30))
interplr_flow <- workflows::workflow()|>
workflows::add_model(plr)|>
workflows::add_recipe(inter_recplr)
set.seed(1516)
inter_folds <- rsample::vfold_cv(inter_train, v=15, strata=Internação)
## doParallel::registerDoParallel()
## tictoc::tic()
interplr_tune <- interplr_flow|>
tune::tune_grid(resamples=inter_folds,
grid=lambda_grid,
control=tune::control_grid(save_pred=TRUE),
metrics=yardstick::metric_set(roc_auc))
## tictoc::toc()interplr_tune|>
tune::select_best()# A tibble: 1 x 2
penalty .config
<dbl> <chr>
1 0.0149 Preprocessor1_Model22(
interplr_best <- interplr_tune|>
tune::collect_metrics()|>
slice(26)
)# A tibble: 1 x 7
penalty .metric .estimator mean n std_err .config
<dbl> <chr> <chr> <dbl> <int> <dbl> <chr>
1 0.0386 roc_auc binary 0.985 15 0.00833 Preprocessor1_Model26interplr_lambdas <- interplr_tune|>
tune::collect_metrics()|>
ggplot(aes(x=penalty, y=mean))+
geom_point(size=3)+
geom_line(lwd=1)+
geom_label(data=interplr_best, aes(label=round(penalty, 5)))+
scale_x_log10(labels=scales::label_number())+
labs(title='Área abaixo da curva ROC',
subtitle='para diferentes penalidades',
caption='Penalidade escolhida em destaque')+
theme_fivethirtyeight(base_size=14)
interplr_lambdaroc <- interplr_tune|>
tune::collect_predictions(parameters=interplr_best)|>
yardstick::roc_curve(Internação, .pred_Não)|>
ggplot(aes(x=(1-specificity), y=sensitivity))+
geom_path(lwd=1)+
geom_abline(lty=3)+
coord_equal()+
labs(title='Curva ROC', subtitle='da penalidade escolhida',
x='1 - especificidade', y='Sensibilidade')+
theme_fivethirtyeight(base_size=14)+
theme(axis.title.x=element_text(
margin=unit(c(t=3, r=0, b=0, l=0), "mm")
),
axis.title.y=element_text(
margin=unit(c(t=0, r=3, b=0, l=0), "mm")
))
interplr_lambdas+
interplr_lambdaroc+
patchwork::plot_layout(widths=c(1.5, 1))
interplr_train <- interplr_flow|>
tune::finalize_workflow(interplr_best)|>
parsnip::fit(inter_train)
interplr_train|>
workflows::pull_workflow_fit()|>
vip::vi()|> ## vip::vip() (it already returns a plot) --------------
dplyr::group_by(Sign)|>
dplyr::filter(Importance>1)|>
dplyr::slice(1:10)|>
dplyr::mutate(Importance=abs(Importance), ## -----------------------
Variable=forcats::fct_reorder(Variable, Importance),
Sign=dplyr::recode(Sign,
NEG='Internação: Não',
POS='Internação: Sim'))|>
ggplot(aes(x=Importance, y=Variable, fill=Sign))+
facet_wrap(~Sign, scales='free')+
geom_bar(stat='identity', alpha=0.75)+
scale_x_continuous(expand=c(0, 0))+
labs(title='Características mais importantes',
subtitle='na classificação do desfecho internação')+
theme_fivethirtyeight(base_size=14)+
theme(legend.position='none',
strip.text.x=element_text(size=14, face='bold'))+
scale_fill_fivethirtyeight()
## broom::tidy(interplr_train)|>
## dplyr::filter(!estimate==0)|>
## dplyr::arrange(estimate)|>
## dplyr::mutate(term=forcats::fct_reorder(term, estimate))|>
## ggplot(aes(x=estimate, y=term))+
## geom_vline(xintercept=0, col='red', linetype=2, lwd=0.8)+
## geom_label(aes(label=round(estimate, 5)))+
## labs(title='Características com estimativas não nulas')+
## theme_fivethirtyeight(base_size=14)interplr_final <- interplr_train|>
tune::last_fit(inter_split)
interplr_auc <- paste('Área abaixo da curva:',
interplr_final|>
tune::collect_predictions()|>
yardstick::roc_auc(Internação, .pred_Não)|>
dplyr::select(.estimate)%>%
round(., 5))
interplr_roc <- interplr_final|>
tune::collect_predictions()|>
yardstick::roc_curve(Internação, .pred_Não)|>
ggplot(aes(x=(1-specificity), y=sensitivity))+
geom_path(lwd=1)+
geom_abline(lty=3)+
coord_equal()+
labs(title='Curva ROC', subtitle=interplr_auc,
x='1 - especificidade', y='Sensibilidade')+
theme_fivethirtyeight(base_size=14)+
theme(axis.title.x=element_text(
margin=unit(c(t=3, r=0, b=0, l=0), "mm")
),
axis.title.y=element_text(
margin=unit(c(t=0, r=3, b=0, l=0), "mm")))
interplr_acc <- paste('Acurácia:',
interplr_final|>
tune::collect_predictions()|>
yardstick::accuracy(Internação, .pred_class)|>
dplyr::select(.estimate)%>%
round(., 3))
interplr_mat <- interplr_final|>
tune::collect_predictions()|>
yardstick::conf_mat(Internação, .pred_class)|>
purrr::pluck(1)|>
tibble::as_tibble()|>
dplyr::rename(Predição=Prediction, Realidade=Truth)|>
ggplot(aes(Predição, Realidade, alpha=n))+
geom_tile(show.legend=FALSE)+
geom_text(aes(label=n), colour='white', alpha=1, size=35)+
labs(title='Necessidade de internação', subtitle=interplr_acc)+
theme_fivethirtyeight(base_size=14)+
theme(axis.title.x=element_text(
margin=unit(c(t=3, r=0, b=0, l=0), "mm")
),
axis.title.y=element_text(
margin=unit(c(t=0, r=3, b=0, l=0), "mm")))
interplr_roc | interplr_mat
uti_plr
utiplr_flow <- workflows::workflow()|>
workflows::add_model(plr)|>
workflows::add_recipe(uti_recplr)
set.seed(1741)
uti_folds <- rsample::vfold_cv(uti_train, v=15, strata=UTI)
utiplr_tune <- utiplr_flow|>
tune::tune_grid(resamples=uti_folds,
grid=lambda_grid,
control=tune::control_grid(save_pred=TRUE),
metrics=yardstick::metric_set(roc_auc))utiplr_tune|>
tune::select_best()# A tibble: 1 x 2
penalty .config
<dbl> <chr>
1 0.0189 Preprocessor1_Model23(
utiplr_best <- utiplr_tune|>
tune::collect_metrics()|>
slice(25)
)# A tibble: 1 x 7
penalty .metric .estimator mean n std_err .config
<dbl> <chr> <chr> <dbl> <int> <dbl> <chr>
1 0.0304 roc_auc binary 0.928 9 0.0209 Preprocessor1_Model25utiplr_lambdas <- utiplr_tune|>
tune::collect_metrics()|>
ggplot(aes(x=penalty, y=mean))+
geom_point(size=3)+
geom_line(lwd=1)+
geom_label(data=utiplr_best, aes(label=round(penalty, 5)))+
scale_x_log10(labels=scales::label_number())+
labs(title='Área abaixo da curva ROC',
subtitle='para diferentes penalidades',
caption='Penalidade escolhida em destaque')+
theme_fivethirtyeight(base_size=14)
utiplr_lambdaroc <- utiplr_tune|>
tune::collect_predictions(parameters=utiplr_best)|>
yardstick::roc_curve(UTI, .pred_Não)|>
ggplot(aes(x=(1-specificity), y=sensitivity))+
geom_path(lwd=1)+
geom_abline(lty=3)+
coord_equal()+
labs(title='Curva ROC', subtitle='da penalidade escolhida',
x='1 - especificidade', y='Sensibilidade')+
theme_fivethirtyeight(base_size=14)+
theme(axis.title.x=element_text(
margin=unit(c(t=3, r=0, b=0, l=0), "mm")
),
axis.title.y=element_text(
margin=unit(c(t=0, r=3, b=0, l=0), "mm")
))
utiplr_lambdas+
utiplr_lambdaroc+
patchwork::plot_layout(widths=c(1.5, 1))
utiplr_train <- utiplr_flow|>
tune::finalize_workflow(utiplr_best)|>
parsnip::fit(uti_train)
utiplr_train|>
workflows::pull_workflow_fit()|>
vip::vi()|> ## vip::vip() (it already returns a plot) --------------
dplyr::group_by(Sign)|>
dplyr::filter(Importance>1)|>
dplyr::slice(1:10)|>
dplyr::mutate(Importance=abs(Importance), ## -----------------------
Variable=forcats::fct_reorder(Variable, Importance),
Sign=dplyr::recode(Sign,
NEG='UTI: Não',
POS='UTI: Sim'))|>
ggplot(aes(x=Importance, y=Variable, fill=Sign))+
facet_wrap(~Sign, scales='free')+
geom_bar(stat='identity', alpha=0.75)+
scale_x_continuous(expand=c(0, 0))+
labs(title='Características mais importantes',
subtitle='na classificação do desfecho UTI')+
theme_fivethirtyeight(base_size=14)+
theme(legend.position='none',
strip.text.x=element_text(size=14, face='bold'))+
scale_fill_fivethirtyeight()
utiplr_final <- utiplr_train|>
tune::last_fit(uti_split)
utiplr_auc <- paste('Área abaixo da curva:',
utiplr_final|>
tune::collect_predictions()|>
yardstick::roc_auc(UTI, .pred_Não)|>
dplyr::select(.estimate)%>%
round(., 5))
utiplr_roc <- utiplr_final|>
tune::collect_predictions()|>
yardstick::roc_curve(UTI, .pred_Não)|>
ggplot(aes(x=(1-specificity), y=sensitivity))+
geom_path(lwd=1)+
geom_abline(lty=3)+
coord_equal()+
labs(title='Curva ROC', subtitle=utiplr_auc,
x='1 - especificidade', y='Sensibilidade')+
theme_fivethirtyeight(base_size=14)+
theme(axis.title.x=element_text(
margin=unit(c(t=3, r=0, b=0, l=0), "mm")
),
axis.title.y=element_text(
margin=unit(c(t=0, r=3, b=0, l=0), "mm")))
utiplr_acc <- paste('Acurácia:',
utiplr_final|>
tune::collect_predictions()|>
yardstick::accuracy(UTI, .pred_class)|>
dplyr::select(.estimate)%>%
round(., 3))
utiplr_mat <- utiplr_final|>
tune::collect_predictions()|>
yardstick::conf_mat(UTI, .pred_class)|>
purrr::pluck(1)|>
tibble::as_tibble()|>
dplyr::rename(Predição=Prediction, Realidade=Truth)|>
ggplot(aes(Predição, Realidade, alpha=n))+
geom_tile(show.legend=FALSE)+
geom_text(aes(label=n), colour='white', alpha=1, size=35)+
labs(title='Necessidade de UTI', subtitle=utiplr_acc)+
theme_fivethirtyeight(base_size=14)+
theme(axis.title.x=element_text(
margin=unit(c(t=3, r=0, b=0, l=0), "mm")
),
axis.title.y=element_text(
margin=unit(c(t=0, r=3, b=0, l=0), "mm")))
utiplr_roc | utiplr_mat
vm_plr
vmplr_flow <- workflows::workflow()|>
workflows::add_model(plr)|>
workflows::add_recipe(vm_recplr)
set.seed(1759)
vm_folds <- rsample::vfold_cv(vm_train, v=15, strata=VM)
vmplr_tune <- vmplr_flow|>
tune::tune_grid(resamples=vm_folds,
grid=lambda_grid,
control=tune::control_grid(save_pred=TRUE),
metrics=yardstick::metric_set(roc_auc))vmplr_tune|>
tune::select_best()# A tibble: 1 x 2
penalty .config
<dbl> <chr>
1 0.0240 Preprocessor1_Model24(
vmplr_best <- vmplr_tune|>
tune::collect_metrics()|>
slice(20)
)# A tibble: 1 x 7
penalty .metric .estimator mean n std_err .config
<dbl> <chr> <chr> <dbl> <int> <dbl> <chr>
1 0.00924 roc_auc binary 0.893 9 0.0374 Preprocessor1_Model20vmplr_lambdas <- vmplr_tune|>
tune::collect_metrics()|>
ggplot(aes(x=penalty, y=mean))+
geom_point(size=3)+
geom_line(lwd=1)+
geom_label(data=vmplr_best, aes(label=round(penalty, 5)))+
scale_x_log10(labels=scales::label_number())+
labs(title='Área abaixo da curva ROC',
subtitle='para diferentes penalidades',
caption='Penalidade escolhida em destaque')+
theme_fivethirtyeight(base_size=14)
vmplr_lambdaroc <- vmplr_tune|>
tune::collect_predictions(parameters=vmplr_best)|>
yardstick::roc_curve(VM, .pred_Não)|>
ggplot(aes(x=(1-specificity), y=sensitivity))+
geom_path(lwd=1)+
geom_abline(lty=3)+
coord_equal()+
labs(title='Curva ROC', subtitle='da penalidade escolhida',
x='1 - especificidade', y='Sensibilidade')+
theme_fivethirtyeight(base_size=14)+
theme(axis.title.x=element_text(
margin=unit(c(t=3, r=0, b=0, l=0), "mm")
),
axis.title.y=element_text(
margin=unit(c(t=0, r=3, b=0, l=0), "mm")
))
vmplr_lambdas+
vmplr_lambdaroc+
patchwork::plot_layout(widths=c(1.5, 1))
vmplr_train <- vmplr_flow|>
tune::finalize_workflow(vmplr_best)|>
parsnip::fit(vm_train)
vmplr_train|>
workflows::pull_workflow_fit()|>
vip::vi()|> ## vip::vip() (it already returns a plot) --------------
dplyr::group_by(Sign)|>
dplyr::filter(Importance>1)|>
dplyr::slice(1:10)|>
dplyr::mutate(Importance=abs(Importance), ## -----------------------
Variable=forcats::fct_reorder(Variable, Importance),
Sign=dplyr::recode(Sign,
NEG='VM: Não',
POS='VM: Sim'))|>
ggplot(aes(x=Importance, y=Variable, fill=Sign))+
facet_wrap(~Sign, scales='free')+
geom_bar(stat='identity', alpha=0.75)+
scale_x_continuous(expand=c(0, 0))+
labs(title='Características mais importantes',
subtitle='na classificação do desfecho VM')+
theme_fivethirtyeight(base_size=14)+
theme(legend.position='none',
strip.text.x=element_text(size=14, face='bold'))+
scale_fill_fivethirtyeight()
vmplr_final <- vmplr_train|>
tune::last_fit(vm_split)
vmplr_auc <- paste('Área abaixo da curva:',
vmplr_final|>
tune::collect_predictions()|>
yardstick::roc_auc(VM, .pred_Não)|>
dplyr::select(.estimate)%>%
round(., 5))
vmplr_roc <- vmplr_final|>
tune::collect_predictions()|>
yardstick::roc_curve(VM, .pred_Não)|>
ggplot(aes(x=(1-specificity), y=sensitivity))+
geom_path(lwd=1)+
geom_abline(lty=3)+
coord_equal()+
labs(title='Curva ROC', subtitle=utiplr_auc,
x='1 - especificidade', y='Sensibilidade')+
theme_fivethirtyeight(base_size=14)+
theme(axis.title.x=element_text(
margin=unit(c(t=3, r=0, b=0, l=0), "mm")
),
axis.title.y=element_text(
margin=unit(c(t=0, r=3, b=0, l=0), "mm")))
vmplr_acc <- paste('Acurácia:',
vmplr_final|>
tune::collect_predictions()|>
yardstick::accuracy(VM, .pred_class)|>
dplyr::select(.estimate)%>%
round(., 3))
vmplr_mat <- vmplr_final|>
tune::collect_predictions()|>
yardstick::conf_mat(VM, .pred_class)|>
purrr::pluck(1)|>
tibble::as_tibble()|>
dplyr::rename(Predição=Prediction, Realidade=Truth)|>
ggplot(aes(Predição, Realidade, alpha=n))+
geom_tile(show.legend=FALSE)+
geom_text(aes(label=n), colour='white', alpha=1, size=35)+
labs(title='Necessidade de VM', subtitle=vmplr_acc)+
theme_fivethirtyeight(base_size=14)+
theme(axis.title.x=element_text(
margin=unit(c(t=3, r=0, b=0, l=0), "mm")
),
axis.title.y=element_text(
margin=unit(c(t=0, r=3, b=0, l=0), "mm")))
vmplr_roc | vmplr_mat